home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / terminal / gp161b / ttt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-09-13  |  10.1 KB  |  373 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V+,X-}
  2. {$M 1024,0,0}
  3.  
  4. PROGRAM TicTacToe;
  5. { Tic Tac Toe für GP }
  6.  
  7.  
  8. USES Dos,GPRI;  { Units DOS und GPRI einbinden }
  9.  
  10. CONST
  11.   MaxHelp        = 16;      { Anzahl der Helptext-Zeilen }
  12.   Wa      : Char = '-';     { ASCII-Zeichen für waagerechten Strich }
  13.   Se      : Char = '!';     { ASCII-Zeichen für senkrechten Strich }
  14.   Kr      : Char = '+';     { ASCII-Zeichen für Kreuz }
  15.  
  16.  
  17. TYPE
  18.   PosiType = ARRAY[0..2,0..2] OF Byte;
  19.  
  20.  
  21.  
  22. VAR
  23.   N             : Byte;
  24.   StrPtr        : String;
  25.   Position      : PosiType;
  26.   HilfsText     : ARRAY[1..MaxHelp] OF String[80];
  27.   Spiel,
  28.   Gewinner      : Byte;
  29.   Zahl          : String[5];
  30.  
  31.  
  32.  
  33.  
  34. FUNCTION GrossSchrift (S : String) : String;
  35. { Wandelt einen Sting in Großbuchstaben um }
  36.  
  37. VAR
  38.   L : Byte;
  39.  
  40. BEGIN
  41.   FOR L := 1 TO Length(S) DO S[L] := UpCase(S[L]);
  42.   GrossSchrift := S;
  43. END;
  44.  
  45.  
  46.  
  47.  
  48. PROCEDURE Strategie;
  49. { Spielstrategie je nach Position der Steine auf dem Spielfeld }
  50.  
  51. VAR
  52.   X,Y,
  53.   N,M   : Byte;
  54.   Bool  : Boolean;
  55.  
  56. BEGIN
  57.   X := 255;
  58.   Y := 255;
  59.   Bool := FALSE;
  60.   FOR N := 0 TO 2 DO BEGIN
  61.     IF NOT Bool AND (Position[N,0] = 0) AND (Position[N,1] > 0)
  62.                 AND (Position[N,2] = Position[N,1]) THEN BEGIN
  63.       X := N;
  64.       Y := 0;
  65.       Bool := Position[N,1] = 2;
  66.     END;
  67.     IF NOT Bool AND (Position[0,N] = 0) AND (Position[1,N] > 0)
  68.                 AND (Position[2,N] = Position[1,N]) THEN BEGIN
  69.       X := 0;
  70.       Y := N;
  71.       Bool := Position[1,N] = 2;
  72.     END;
  73.     IF NOT Bool AND (Position[N,2] = 0) AND (Position[N,0] > 0)
  74.                 AND (Position[N,0] = Position[N,1]) THEN BEGIN
  75.       X := N;
  76.       Y := 2;
  77.       Bool := Position[N,0] = 2;
  78.     END;
  79.     IF NOT Bool AND (Position[2,N] = 0) AND (Position[0,N] > 0)
  80.                 AND (Position[0,N] = Position[1,N]) THEN BEGIN
  81.       X := 2;
  82.       Y := N;
  83.       Bool := Position[0,N] = 2;
  84.     END;
  85.     IF NOT Bool AND (Position[N,1] = 0) AND (Position[N,0] > 0)
  86.                 AND (Position[N,0] = Position[N,2]) THEN BEGIN
  87.       X := N;
  88.       Y := 1;
  89.       Bool := Position[N,0] = 2;
  90.     END;
  91.     IF NOT Bool AND (Position[1,N] = 0) AND (Position[0,N] > 0)
  92.                 AND (Position[0,N] = Position[2,N]) THEN BEGIN
  93.       X := 1;
  94.       Y := N;
  95.       Bool := Position[0,N] = 2;
  96.     END;
  97.   END;
  98.   IF NOT Bool AND (Position[1,1] = 0) AND ((Position[0,0] > 0)
  99.               AND (Position[0,0] = Position[2,2])
  100.               OR  (Position[2,0] > 0)
  101.               AND (Position[2,0] = Position[0,2])) THEN BEGIN
  102.     X := 1;
  103.     Y := 1;
  104.     Bool := Position[0,0] = 2;
  105.   END;
  106.   IF Position[1,1] > 0 THEN BEGIN
  107.     IF NOT Bool AND (Position[0,0] = 0)
  108.                 AND (Position[1,1] = Position[2,2]) THEN BEGIN
  109.       X := 0;
  110.       Y := 0;
  111.       Bool := Position[1,1] = 2;
  112.     END;
  113.     IF NOT Bool AND (Position[2,2] = 0)
  114.                 AND (Position[1,1] = Position[0,0]) THEN BEGIN
  115.       X := 2;
  116.       Y := 2;
  117.       Bool := Position[1,1] = 2;
  118.     END;
  119.     IF NOT Bool AND (Position[0,2] = 0)
  120.                 AND (Position[1,1] = Position[2,0]) THEN BEGIN
  121.       X := 0;
  122.       Y := 2;
  123.       Bool := Position[1,1] = 2;
  124.     END;
  125.     IF NOT Bool AND (Position[2,0] = 0)
  126.                AND (Position[1,1] = Position[0,2]) THEN BEGIN
  127.       X := 2;
  128.       Y := 0;
  129.       Bool := Position[1,1] = 2;
  130.     END;
  131.   END;
  132.   IF (X = 255) THEN
  133.     REPEAT
  134.       X := Random(3);
  135.       Y := Random(3);
  136.     UNTIL Position[X,Y] = 0;
  137.   Position[X,Y] := 2;
  138. END;
  139.  
  140.  
  141. PROCEDURE ResetSpielFeld;
  142. { Alle Steine vom Spielfeld räumen }
  143.  
  144. VAR
  145.   X,Y   : Byte;
  146.  
  147. BEGIN
  148.   FOR Y := 0 TO 2 DO
  149.     FOR X := 0 TO 2 DO
  150.       Position[X,Y] := 0;
  151. END;
  152.  
  153.  
  154. FUNCTION Sieger : Byte;
  155. { Ermittelt den Gewinner der Patie.     }
  156. { Ausgabe:  0 = Spiel noch nicht zuende }
  157. {           1 = Spieler hat gewonnen    }
  158. {           2 = Computer hat gewonnen   }
  159. {           3 = Unentschieden           }
  160.  
  161. VAR
  162.   N,S   : Byte;
  163.  
  164. BEGIN
  165.   S := 0;
  166.   N := 0;
  167.   WHILE (S = 0) AND (N < 3) DO BEGIN
  168.     IF (Position[N,0] = Position[N,1]) AND (Position[N,0] = Position[N,2]) THEN
  169.       S := Position[N,0];
  170.     Inc(N);
  171.   END;
  172.   N := 0;
  173.   WHILE (S = 0) AND (N < 3) DO BEGIN
  174.     IF (Position[0,N] = Position[1,N]) AND (Position[0,N] = Position[2,N]) THEN
  175.       S := Position[0,N];
  176.     Inc(N);
  177.   END;
  178.   IF S = 0 THEN
  179.     IF (Position[0,0] = Position[1,1]) AND (Position[0,0] = Position[2,2]) THEN
  180.       S := Position[0,0];
  181.   IF S = 0 THEN
  182.     IF (Position[0,2] = Position[1,1]) AND (Position[0,2] = Position[2,0]) THEN
  183.       S := Position[0,2];
  184.   IF S = 0 THEN BEGIN
  185.     N := 0;
  186.     WHILE (N < 8) AND (Position[N MOD 3,N DIV 3] > 0) DO
  187.       Inc(N);
  188.     IF N = 8 THEN S := 3;
  189.   END;
  190.   Sieger := S;
  191. END;
  192.  
  193.  
  194.  
  195. FUNCTION SpielFeld : String;
  196. { "Zeichnet" das Spielfeld }
  197.  
  198. VAR
  199.   S   : String;
  200.   X,Y : Byte;
  201.  
  202. BEGIN
  203.   S := '      A   B   C  '#13+
  204.        '        '+Se+'   '+Se+'   1'#13+
  205.        '     '+Wa+Wa+Wa+Kr+Wa+Wa+Wa+Kr+Wa+Wa+Wa+' '#13+
  206.        '        '+Se+'   '+Se+'   2'#13+
  207.        '     '+Wa+Wa+Wa+Kr+Wa+Wa+Wa+Kr+Wa+Wa+Wa+' '#13+
  208.        '        '+Se+'   '+Se+'   3'#13;
  209.   FOR Y := 0 TO 2 DO
  210.     FOR X := 0 TO 2 DO BEGIN
  211.       IF Position[X,Y] = 1 THEN S[(X*4+7)+(Y*36+18)] := 'X';
  212.       IF Position[X,Y] = 2 THEN S[(X*4+7)+(Y*36+18)] := 'O';
  213.     END;
  214.   Gewinner := Sieger;
  215.   IF Gewinner > 0 THEN BEGIN
  216.     S := S+#13;
  217.     IF Gewinner = 1 THEN S := S+'Gratuliere, Sie haben gewonnen.';
  218.     IF Gewinner = 2 THEN S := S+'Sie haben leider verloren.';
  219.     IF Gewinner = 3 THEN S := S+'Unentschieden.';
  220.     S := S+#13;
  221.     S := S+'Ein weiteres Spiel ? (J/N) > ';
  222.     Spiel := 1;
  223.   END ELSE
  224.     S := S+'> ';
  225.   SpielFeld := #13+S;
  226. END;
  227.  
  228.  
  229. FUNCTION Parser (S : String) : Boolean;
  230.  
  231. VAR
  232.   X,Y  : Byte;
  233.  
  234. BEGIN
  235.   IF (S[1] >= 'A') AND (S[1] <= 'C') AND
  236.      (S[2] > '0') AND (S[2] < '4') THEN BEGIN
  237.     X := Ord(S[1])-65;
  238.     Y := Ord(S[2])-49;
  239.     IF Position[X,Y] = 0 THEN BEGIN
  240.       Position[X,Y] := 1;
  241.       Parser := TRUE;
  242.     END ELSE
  243.       Parser := FALSE;
  244.   END ELSE
  245.     Parser := FALSE;
  246. END;
  247.  
  248.  
  249.  
  250. {$F+}
  251. { Von hier an werden die Routinen FAR compiliert }
  252.  
  253.  
  254. PROCEDURE RX (S : String);
  255.  
  256. BEGIN
  257.   ProgrammEnde := FALSE;
  258.   N := Pos('> ',S);
  259.   IF N > 0 THEN Delete(S,1,N+1);
  260.   IF S[1] > #96 THEN Dec(Byte(S[1]),32);
  261.   CASE Spiel OF
  262.     0: BEGIN   { normaler Spielmodus }
  263.          IF Parser(S) THEN BEGIN
  264.            IF Sieger = 0 THEN Strategie;
  265.            StrPtr := SpielFeld;
  266.          END ELSE BEGIN
  267.            IF Upcase(S[1]) = 'E' THEN BEGIN
  268.              ProgrammEnde := TRUE;
  269.              StrPtr := #13'Spiel abgebrochen.'#13;
  270.            END ELSE BEGIN
  271.              IF Upcase(S[1]) = 'I' THEN BEGIN
  272.                Se := '│';
  273.                Wa := '─';
  274.                Kr := '┼';
  275.                StrPtr := 'IBM-Zeichensatz aktiviert.'#13+SpielFeld;
  276.              END ELSE BEGIN
  277.                IF S[1] = '?' THEN BEGIN
  278.                  FOR N := 1 TO MaxHelp DO
  279.                    SendString(HilfsText[N]);
  280.                  StrPtr := SpielFeld;
  281.                END ELSE BEGIN
  282.                  StrPtr := 'Ungueltiges Feld oder Feld schon besetzt.'#13'> ';
  283.                END;
  284.              END;
  285.            END;
  286.          END;
  287.        END;
  288.     1: BEGIN   { Antwort auf Frage nach neuem Spiel auswerten }
  289.          IF (S[1] = 'J') OR (S[1] = 'Y') THEN BEGIN
  290.            ResetSpielFeld;
  291.            Randomize;
  292.            IF Gewinner = 1 THEN Strategie;
  293.            Gewinner := 0;
  294.            StrPtr := SpielFeld;
  295.            Spiel := 0;
  296.          END ELSE BEGIN
  297.            ProgrammEnde := TRUE;  { GP auffordern, das Programm zu beenden }
  298.            StrPtr := '73 und bis bald mal wieder...'#13;
  299.          END;
  300.        END;
  301.   END;
  302.   SendString(StrPtr);  { Datenstring aussenden }
  303. END;
  304.  
  305.  
  306.  
  307.  
  308. PROCEDURE Intro;
  309.  
  310. VAR
  311.   I       : Byte;
  312.   S1,S2   : String[2];
  313.  
  314. BEGIN
  315.   IF ParamCount > 0 THEN     { Kommandozeile nach Wort "IBM" durchsuchen }
  316.     FOR I := 1 TO ParamCount DO
  317.       IF GrossSchrift(ParamStr(I)) = 'IBM' THEN BEGIN
  318.         { Wenn gefunden, IBM-Grafikzeichen verwenden }
  319.         Se := '│';
  320.         Wa := '─';
  321.         Kr := '┼';
  322.       END;
  323.   Randomize;
  324.   Gewinner := 0;
  325.   Spiel := 0;
  326.   ResetSpielFeld;
  327.   Str(GPRI_VersionHi:2,S1);
  328.   Str(GPRI_VersionLo,S2);
  329.   IF GPRI_VersionLo < 10 THEN S2 := '0'+S2;
  330.   StrPtr := '**** Tic Tac Toe for GP ****'#13+
  331.             '*** (C) Ulf Saran DH1DAE ***'#13+
  332.             '**** GPRI Version '+S1+'.'+S2+' ****'#13+
  333.             '("?" = Hilfe';
  334.   IF Se <> '│' THEN
  335.     StrPtr := StrPtr+'  "IBM" = IBM-Zeichensatz)'+#13#13
  336.   ELSE
  337.     StrPtr := StrPtr+')'#13#13;
  338.   SendString(StrPtr);  { Datenstring aussenden }
  339.   StrPtr := SpielFeld; { Datenstring mit Spielfeld laden }
  340.   SendString(StrPtr);  { Datenstring aussenden }
  341. END;
  342.  
  343.  
  344.  
  345. VAR
  346.   Num    : Word;
  347.   Task   : TaskType;
  348.  
  349. BEGIN
  350.   IF NOT TaskInit(@Intro,@RX,NIL,NIL) THEN BEGIN
  351.     Writeln('Dieses Programm kann nur als GP Remote-Programm gestartet werden.');
  352.     Halt;
  353.   END;
  354.   Hilfstext[1] := 'Kurzbeschreibung von Tic Tac Toe fuer GP:'#13#13;
  355.   HilfsText[2] := 'Sinn des Spiels ist es, drei eigene Spielsteine entweder'#13;
  356.   HilfsText[3] := 'horizontal, vertikal oder diagonal nebeneinander anzuordnen.'#13;
  357.   HilfsText[4] := 'Ihre Spielsteine werden dabei durch ein X gekennzeichnet,'#13;
  358.   HilfsText[5] := 'die des Computers durch ein O.'#13;
  359.   HilfsText[6] := 'Die Spielfelder werden durch eine Kombination aus je einem'#13;
  360.   HilfsText[7] := 'Buchstaben und einer Ziffer gekennzeichnet. Das linke obere'#13;
  361.   HilfsText[8] := 'Feld ist die Position A1, das rechte untere Feld C3'#13#13;
  362.   HilfsText[9] := 'Die Eingabe der Positionsangaben erfolgt interaktiv, d.h.'#13;
  363.   HilfsText[10] := 'Sie brauchen nur die Eingabeaufforderung abzuwarten und dann'#13;
  364.   HilfsText[11] := 'einfach die gewünschten Koordinaten einzugeben.'#13#13;
  365.   HilfsText[12] := 'Am Ende eines Spiels koennen sie ein neues Spiel starten.'#13;
  366.   HilfsText[13] := 'Entscheiden Sie sich fuer ein neues Spiel, dann beginnt'#13;
  367.   HilfsText[14] := 'derjenige, der das letzte Spiel verloren hat. Bei einem'#13;
  368.   HilfsText[15] := 'Unentschieden fangen Sie an.'#13;
  369.   HilfsText[16] := 'Die Eingabe von EXIT beendet das Spiel vorzeitig.'#13;
  370.   Keep(0);  { Programm speicherresident installieren }
  371. END.
  372.  
  373.